home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994…tember: Reference Library / Dev.CD Sep 94.toast / Periodicals / develop / develop Issue 11 / develop 11 code / The NetWork Project / Examples (Sources) / NetSim / task.handlers.impl.p < prev    next >
Encoding:
Text File  |  1992-07-15  |  3.5 KB  |  142 lines  |  [TEXT/MPS ]
  1. {© G. Sawitzki, StatLab Heidelberg 1986-1991}    
  2.  
  3.  
  4. {***************************************************************}
  5.  
  6. var goodByeMsgHeader:tMsgHeader;    {bad pgmming:fixed buffer, no semaphore… just lazy}
  7. procedure SendLocalGoodBye(who:longint);
  8. var msg:msgPtr;
  9.     me,Dest:msgAddr;
  10. BEGIN
  11.     if who<>0 then
  12.     begin
  13.         preparemessageHeader(goodByeMsgHeader,aDone);
  14.         me:=NetWorkScheduler.MySelf;
  15.         Dest.p:=who;
  16.         Dest.a := 0; { local }
  17.         if master then if 
  18.         postmsg(msg,nil,cMsgNAttention+cMustBeLaunched,
  19.         NetWorkScheduler.TaskGenerator.ContextStamp,
  20.         Dest,me,
  21.         @goodByeMsgHeader,sizeof(goodByeMsgHeader),nil,0)<>noErr then;
  22.     end;
  23. END;
  24.  
  25.  
  26.  
  27. {**********************************************************}
  28. {try to pass all messages through this function. The information
  29. passed in moreinfo belongs to the recipient.}
  30. function ProcessMsg(var msghdr:tMsgHeader; var moreinfo:handle;islocal:boolean):osErr;
  31. begin
  32.     ProcessMsg:=NoErr;
  33.  
  34.     with msgHdr do
  35.     case action of
  36.         aNoop:;
  37.         aExample:;
  38.         aDone:ProgramBreak('Bad action code: aDone');
  39.         aShow:begin {if it is a picture, show it}
  40.             DoTaskUpdate(moreinfo,msghdr,islocal);
  41.         end;
  42.  
  43.         otherwise
  44.  
  45.     end;
  46.     if moreinfo<>nil then begin
  47.         disposHandle(moreinfo);
  48.         moreinfo:=nil;
  49.     end;
  50. end;
  51.  
  52.  
  53. {=============================================================================}
  54.  
  55. {handlers for the communication system}
  56.  
  57.  
  58.  
  59.  
  60. {---------------------------------------------------------------}
  61. {    MyTaskGenerator    }
  62.  
  63. {We send a header of small, fixed size, and no data. We expect quick 
  64. transmission, and very rare situations of multiple use.
  65. Buffer strategy: one recycled dynamic buffer, with possibly additional
  66. buffers.}
  67.  
  68. type
  69.     tMyTaskGenerator=object(tTaskGenerator)
  70.         latchedbuffer:tMsgHeaderPtr;
  71.         procedure init; override;
  72.     function tMyTaskGenerator.NewTask(var msg:MsgPtr):boolean;override;
  73.     function tMyTaskGenerator.NewPrioPtr(var PrioSize:longint):ptr;override;
  74.     function tMyTaskGenerator.NewCorePtr(var CoreSize:longint):ptr;override;
  75.     procedure tMyTaskGenerator.DisposPrioPtr(var PrioPtr:UNIV Ptr);override;
  76.     procedure tMyTaskGenerator.DisposCorePtr(var CorePtr:UNIV Ptr);override;
  77.     end;
  78.  
  79. procedure tMyTaskGenerator.init;
  80. begin
  81.     inherited init;
  82.     latchedbuffer:=nil;
  83.     TickleInterval:=5;
  84.     Waitinterval:=1;
  85. end;
  86.  
  87.  
  88. function tMyTaskGenerator.NewTask(var Msg:MsgPtr):boolean;override;
  89. var tempstr,s:str255;
  90.     l:longint;
  91. begin
  92.     NewTask:=inherited NewTask(Msg);
  93.  
  94.     with msg^ do if MsgDest.a<>0 then
  95.     begin
  96.         MsgPrioSize:=sizeof(tMsgHeader);
  97.  
  98.         if (theConfiguration.UseMessageSizes) & (MsgPrioSize<= theConfiguration.MinPrioSize) then 
  99.         MsgPrioSize:=theConfiguration.MinPrioSize;
  100.  
  101.         MsgPrioPtr:=NewPrioPtr(MsgPrioSize);
  102.         if MsgPrioPtr<>nil then begin
  103.             DefineTask(tMsgHeaderPtr(MsgPrioPtr)^);
  104.             NewTask:=true;
  105.             stamp(msg);
  106.         end;
  107.     end;
  108. end;
  109.  
  110. function tMyTaskGenerator.NewPrioPtr(var PrioSize:longint):ptr;override;
  111. begin
  112.     if (latchedbuffer<>nil) & (PrioSize>GetPtrSize(Ptr(latchedbuffer))) then 
  113.     begin 
  114.         DisposPtr(Ptr(latchedbuffer));
  115.         latchedbuffer:=nil;
  116.     end;
  117.     if latchedbuffer<>nil then begin
  118.         if spare then ProgramBreak(' overrun');
  119.         NewPrioPtr:=Ptr(latchedbuffer);
  120.         latchedbuffer:=nil;
  121.     end
  122.     else NewPrioPtr:=NewPtr(PrioSize);
  123. end;
  124.  
  125. procedure tMyTaskGenerator.DisposPrioPtr(var PrioPtr:UNIV Ptr);override;
  126. begin
  127.     if latchedbuffer=nil then latchedbuffer:=tMsgHeaderPtr(PrioPtr) else disposPtr(PrioPtr);
  128.     PrioPtr:=nil;
  129. end;
  130.  
  131. function tMyTaskGenerator.NewCorePtr(var CoreSize:longint):ptr;override;
  132. begin
  133.     ProgramBreak('not implemented');
  134.     NewCorePtr:=nil;
  135. end;
  136.  
  137. procedure tMyTaskGenerator.DisposCorePtr(var CorePtr:UNIV Ptr);override;
  138. begin
  139.     ProgramBreak('not implemented');
  140. end;
  141.  
  142.